COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(* $A+,D+*)
C00008 ENDMK
C⊗;
(* $A+,D+*)
program CRYPT;
const	MAXA = 3;  MAXB = 5;  MAXC = 6;  MAXD = 15;  LIM = 20;
var	I, J, K, L,LA, LB, M, N, CAR, HIT : integer;
	A, B, C, D : array [0..LIM] of integer;
procedure TESTHIT;
    begin
    K := MAXC;
    while C[K] = 0 do K := K - 1;
    L := LA;
    for M := K downto 1 do
	begin
	L := L + 1;  D[L] := C[M];
	end;
    HIT := 0;
    for M := L downto LA do
	for N := M-1 downto 1 do
	    if D[M] = D[N] then HIT := HIT + 1;
    end;
begin (* Main program*)
writeln (OUTPUT,'Possible solutions');
writeln (OUTPUT);
for I := 1 to MAXD do
    begin
    A[I] := 0;  B[I] := 0;  C[I] := 0;  D[I] := 0;
    end;
A[1] := 2;  B[1] := 2;  B[3] := 1;  CAR := 0;  I := 1;  J := 3;
LB := 0;  HIT := 0;
for M := J downto 1 do 
    begin
    LB := LB + 1;  D[LB] := B[M];
    end;
while CAR = 0 do
    begin
    LA := LB;
    for M := I downto 1 do
	begin
	LA := LA + 1;  D[LA] := A[M];
	end;
    for M := LA downto LB do
	for N := M -1 downto 1 do
	    if D[M] = D[N] then HIT := 1;
    K := J*2+I;
    if ((K < 11) and (K > 7) and (HIT=0)) then 
	begin
	if (I + J) = 5 then	(* Product case is in range*)
	    begin
	    for K := 1 to MAXD do C[K] := 0;
	    for M := 1 to MAXA do
		for N := 1 to MAXB do
		    begin
		    K := M + N - 1;
		    C[K] := A[M] * B[N] + C[K];
		    end;
	    for K := 2 to MAXC do
		begin
		C[K] := C[K] + C[K-1] div 10;
		C[K-1] := C[K-1] mod 10;
		end;
	    TESTHIT;
	    if (HIT = 0) and (L = 10) then
		begin
		write (TTY,L:5,HIT:2,' * '); BREAK;
		for M := I downto 1 do write (OUTPUT,A[M]:1);
		write (OUTPUT,' * ');
		for M := J downto 1 do write (OUTPUT,B[M]:1);
		write (OUTPUT,' = ');
		for M := K downto 1 do write (OUTPUT,C[M]:1);
		writeln (OUTPUT);
		end;
	    end;                            (* Product case in range*)
	for K := 1 to MAXD do C[K] := 0;
	for K := 1 to MAXC do
	    begin
	    C[K] := A[K] + B[K] + CAR;
	    CAR := C[K] div 10;
	    C[K] := C[K] mod 10;
	    end;
	TESTHIT;
	if (HIT = 0) and (L = 10) then
	    begin
	    write (TTY,L:5,HIT:2,' + '); BREAK;
	    for M := I downto 1 do write (OUTPUT,A[M]:1);
	    write (OUTPUT,' + ');
	    for M := J downto 1 do write (OUTPUT,B[M]:1);
	    write (OUTPUT,' = ');
	    for M := K downto 1 do write (OUTPUT,C[M]:1);
	    writeln (OUTPUT);
	    end;
	end;	 (*if ((K < 11) and (K > 7) and (HIT=0)) *)
    CAR := 1;  HIT := 0;
    for I := 1 to MAXA do
	begin
	A[I] := A[I] + CAR;
	CAR := A[I] div 10;
	A[I] := A[I] mod 10;
	end;
    I := MAXD;
    while A[I] = 0 do I := I - 1;
    if I = J then if A[I]> B[J] then CAR := 1;
    if CAR = 1 then
	begin       (* CAR <> 0 *)
	for I := 2 to MAXD do A[I] := 0;
	I := 1;
	A[I] := 2;
	HIT := 1;  CAR := 0;
	while ((HIT<>0) and (CAR=0)) do
	    begin
	    CAR := 1;
	    for J := 1 to MAXB do
		begin
		B[J] := B[J] + CAR;
		CAR := B[J] div 10;
		B[J] := B[J] mod 10;
		end;
	    J := MAXD;
	    while B[J] = 0 do J := J - 1;
	    LB := 0;  HIT := 0;
	    for M := J downto 1 do
		begin
		LB := LB + 1;  D[LB] := B[M];
		end;
	    for M := LB downto 2 do
		for N := M-1 downto 1 do
		    if D[M] = D[N] then HIT := 1;
	    end;    (* while HIT<>0 and CAR=0 *)
	end;	(* if CAR = 1 *)
    end; (* while CAR = 0 *)
end.